home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / xp-setup_v2140951202009.psc / class module / clsDockingHandler.cls next >
Text File  |  2008-12-22  |  5KB  |  152 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsDockingHandler"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. Private mParentForm As Form
  19. Private mAlwaysOnTop As Boolean
  20. Private mSnapDistance As Long
  21. Private mStartDragX As Single
  22. Private mStartDragY As Single
  23. Private mWorkAreaRect As RECT
  24. Private mAttachedToRight As Boolean
  25. Private mAttachedToLeft As Boolean
  26. Private mAttachedToTop As Boolean
  27. Private mAttachedToBottom As Boolean
  28. Private mWindowStyle As Long
  29.  
  30. Public Sub StartDockDrag(ByVal X As Single, ByVal Y As Single)
  31.     SystemParametersInfo SPI_GETWORKAREA, 0&, mWorkAreaRect, 0&
  32.     mWorkAreaRect.Top = mWorkAreaRect.Top * Screen.TwipsPerPixelY
  33.     mWorkAreaRect.Left = mWorkAreaRect.Left * Screen.TwipsPerPixelX
  34.     mWorkAreaRect.Bottom = mWorkAreaRect.Bottom * Screen.TwipsPerPixelY
  35.     mWorkAreaRect.Right = mWorkAreaRect.Right * Screen.TwipsPerPixelX
  36.     mStartDragX = X
  37.     mStartDragY = Y
  38. End Sub
  39.  
  40. Public Sub UpdateDockDrag(ByVal X As Single, ByVal Y As Single)
  41. Dim DiffX As Long, DiffY As Long
  42. Dim NewX As Long, NewY As Long
  43. Dim ToLeftDistance As Long
  44. Dim ToRightDistance As Long
  45. Dim ToTopDistance As Long
  46. Dim ToBottomDistance As Long
  47.     If ParentForm Is Nothing Then Exit Sub
  48.     DiffX = X - mStartDragX
  49.     DiffY = Y - mStartDragY
  50.     If DiffX = 0 And DiffY = 0 Then Exit Sub
  51.     NewX = mParentForm.Left + DiffX
  52.     NewY = mParentForm.Top + DiffY
  53.     ToRightDistance = mWorkAreaRect.Right - (NewX + mParentForm.Width)
  54.     ToLeftDistance = NewX - mWorkAreaRect.Left
  55.     ToBottomDistance = mWorkAreaRect.Bottom - (NewY + mParentForm.Height)
  56.     ToTopDistance = NewY - mWorkAreaRect.Top
  57.     If Not mAttachedToBottom Then
  58.         If Abs(ToBottomDistance) <= mSnapDistance Then
  59.             NewY = mParentForm.Top + ToBottomDistance
  60.             mAttachedToBottom = True
  61.         End If
  62.     Else
  63.         If Abs(ToBottomDistance) > mSnapDistance Then
  64.             mAttachedToBottom = False
  65.         Else
  66.             NewY = mParentForm.Top
  67.         End If
  68.     End If
  69.     If Not mAttachedToTop Then
  70.         If Abs(ToTopDistance) <= mSnapDistance Then
  71.             NewY = mWorkAreaRect.Top
  72.             mAttachedToTop = True
  73.         End If
  74.     Else
  75.         If Abs(ToTopDistance) > mSnapDistance Then
  76.             mAttachedToTop = False
  77.         Else
  78.             NewY = mParentForm.Top
  79.         End If
  80.     End If
  81.     If Not mAttachedToRight Then
  82.         If Abs(ToRightDistance) <= mSnapDistance Then
  83.             NewX = mWorkAreaRect.Right - mParentForm.Width
  84.             mAttachedToRight = True
  85.         End If
  86.     Else
  87.         If Abs(ToRightDistance) > mSnapDistance Then
  88.             mAttachedToRight = False
  89.         Else
  90.             NewX = mParentForm.Left
  91.         End If
  92.     End If
  93.     If Not mAttachedToLeft Then
  94.         If Abs(ToLeftDistance) <= mSnapDistance Then
  95.             NewX = mWorkAreaRect.Left
  96.             mAttachedToLeft = True
  97.         End If
  98.     Else
  99.         If Abs(ToLeftDistance) > mSnapDistance Then
  100.             mAttachedToLeft = False
  101.         Else
  102.             NewX = mParentForm.Left
  103.         End If
  104.     End If
  105.     SetWindowPos mParentForm.hwnd, mWindowStyle, _
  106.         NewX / Screen.TwipsPerPixelX, _
  107.         NewY / Screen.TwipsPerPixelY, _
  108.         mParentForm.Width / Screen.TwipsPerPixelX, _
  109.         mParentForm.Height / Screen.TwipsPerPixelY, 0
  110. End Sub
  111.  
  112. Public Property Set ParentForm(vData As Form)
  113.     Set mParentForm = vData
  114. End Property
  115.  
  116. Public Property Get ParentForm() As Form
  117.     Set ParentForm = mParentForm
  118. End Property
  119.  
  120. Public Property Let AlwaysOnTop(vData As Boolean)
  121.     mAlwaysOnTop = vData
  122.     If mAlwaysOnTop Then
  123.         mWindowStyle = HWND_TOPMOST
  124.     Else
  125.         mWindowStyle = HWND_NOTOPMOST
  126.     End If
  127.     If Not ParentForm Is Nothing Then
  128.         SetWindowPos mParentForm.hwnd, mWindowStyle, _
  129.             mParentForm.Left / Screen.TwipsPerPixelX, _
  130.             mParentForm.Top / Screen.TwipsPerPixelY, _
  131.             mParentForm.Width / Screen.TwipsPerPixelX, _
  132.             mParentForm.Height / Screen.TwipsPerPixelY, 0
  133.     End If
  134. End Property
  135.  
  136. Public Property Get AlwaysOnTop() As Boolean
  137.     AlwaysOnTop = mAlwaysOnTop
  138. End Property
  139.  
  140. Public Property Let SnapDistance(vData As Long)
  141.     mSnapDistance = vData
  142. End Property
  143.  
  144. Public Property Get SnapDistance() As Long
  145.     SnapDistance = mSnapDistance
  146. End Property
  147.  
  148. Private Sub Class_Initialize()
  149.     mWindowStyle = HWND_NOTOPMOST
  150.     mSnapDistance = 10 * Screen.TwipsPerPixelX
  151. End Sub
  152.